Optional Tasks.f

{
Saving/restoring game state
  Easiest way: save the entire dictionary starting from ORIGIN in a file, with an entry point in the first cell probably.
  Would need to save buffers too.
}

Requires Tools
Requires Structs
Requires SORA\Blocks

Only Forth Definitions

0 Value mind

: task   blk @ ;


[undefined] default-tasks-dstack-size [if] block-size 3 / cell/ cells Constant default-tasks-dstack-size [then]
[undefined] default-tasks-rstack-size [if] block-size 3 / cell/ cells Constant default-tasks-rstack-size [then]

default-tasks-dstack-size 8 cells - Constant dstack-start
default-tasks-rstack-size 8 cells - Constant rstack-start

\ : task-property   &of mind property ;

/Node inherit
   cell field ->sp
   cell field ->rp
   default-tasks-dstack-size  field ->dstack
   default-tasks-rstack-size  field ->rstack
End-struct /Task

Block-type: [Task]
   /Task blk property taskbase        \ ->rp and ->sp etc can be used directly on a Task (syntax: "n BLOCK ->SP ?"), for ease of debugging

:macro sp   taskbase ->sp ;
:macro rp   taskbase ->rp ;
:macro dstack   taskbase ->dstack ;
:macro rstack   taskbase ->rstack ;

code pause   ( -- )
   PUSH(EBX)
   &of mind [u] ebx mov
   'lf [u] push         \ save locals frame
   blk [u] push
   ebp 0 ->sp [ebx] mov
   0 ->next [ebx] ecx mov      \ get next task
   esp 0 ->rp [ebx] mov
    ecx ecx or  0= if
      0 ->parent [ebx] ebx mov
      0 ->first [ebx] ecx mov   \ go back to first task of ring
   then
   0 ->rp [ecx] esp mov     \ get stack pointers
   0 ->sp [ecx] ebp mov
   blk [u] pop
   'lf [u] pop          \ restore locals frame
   ecx &of mind [u] mov       \ store new task pointer
   POP(EBX)
   ret end-code

code unpause
   0 ->rp [ebx] esp mov     \ get stack pointers
   0 ->sp [ebx] ebp mov
   blk [u] pop
   'lf [u] pop              \ restore locals frame
   ebx &of mind [u] mov     \ store new task pointer
   POP(EBX)
   ret end-code

:[] act:[   ( val task xt -- )
   >code swap ( x code task ) <<
   rstack rstack-start + cell- cell- rp !     \ initialize return stack
   \ rstack rstack-start + rp !     \ initialize return stack
   dstack dstack-start + sp !           \ initialize data stack
   rp @ cell+ cell+ !                       \ set return
   \ rp @ !                            \ set return
   sp @ !                             \ set tos
   mind task = if
      rp @ rp! sp @ sp! exit         \ case for task assigning itself
   then
   >> ;

: peek
   << cr ." Data stack: "
       sp @ begin cr space @+ . dup dstack dstack-start + > until drop
      cr ." Return stack: "
       rp @ begin cr space @+ . dup rstack rstack-start + > until drop
   >> ;


: halt   0 swap act:[ begin pause again ;] ;

: doze   begin pause again ;

\ -? create dummy /task allot

: pauses  0 do pause loop ;

: end
   mind ->next @
   mind dispose
   mind remove-node
   unpause ;

: add-task   ( task ring -- )
   add-child ;

: new-task  ( ring -- task )
   generate dup halt  dup rot add-task ;

AKA /Node /Ring

: jolt ( ring -- )
   ->first @ ?dup 0= ?exit
   mind >q
   sp@ >q
   rp@ >q
   to mind pause
   q> rp!
   q> sp!
   q> to mind
   drop ;

\ Rings need an extra task at the beginning so JOLT can save and restore the caller's state.
: init-ring    new-task drop ;

block-size constant /Task

: Ring:   ( -- <name> ) create here /Ring /allot  init-ring ;
: Task:   ( -- <name> ) create here /Task /allot  halt ;

: peek
   << cr ." Data stack: "
       sp @ begin cr space @+ . dup dstack dstack-start + > until drop
      cr ." Return stack: "
       rp @ begin cr space @+ . dup rstack rstack-start + > until drop
   >> ;


{
0 value assumed

\ Help in debugging tasks by letting you peek into tasks.
\   The given task's internal data stack is pushed onto GOD's stack,
\   and GOD is swapped with the task.
\ -ASSUME will swap things back into position, discarding the data stack.
: assume ( task -- )
   to assumed
   s0 @ sp!
   god assumed link-node
   assumed remove-node
   assumed ->sp @
   assumed ->dstack dstack-start +
   2dup > abort" There is a stack underflow in the task."
   do   i @   -cell  +loop ;

: -assume   assumed god link-node  god main add-child  s0 @ sp! ;
}

\ Initialize mind to the app-level task and attach it to a default ring:
Ring: main
Task: god
god main add-task
god to mind

pause


\ Test
\\

Ring: Jack
Ring: Queen

variable n

: test   new-task 0 swap act:[ begin 10 0 do i n +! pause loop again ;] ;
: test2   new-task 0 swap act:[ begin jack jolt pause again ;] ;

jack test
queen test2
queen jolt n ?
queen jolt n ?
main-ring test2
pause n ?


